home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM 1995 Fall / PD-ROM F95.toast / Programming / Programming Languages / UCB Logo 3.0 ƒ / CSLS / playfair < prev    next >
Encoding:
Text File  |  1992-09-04  |  2.2 KB  |  101 lines  |  [TEXT/ttxt]
  1. TO BIGWORD :LIST
  2. IF EMPTYP :LIST [OUTPUT "]
  3. OUTPUT WORD FIRST :LIST BIGWORD BF :LIST
  4. END
  5.  
  6. TO ENCODE :MESSAGE
  7. IF EMPTYP :MESSAGE [OUTPUT "]
  8. IF EMPTYP BF :MESSAGE [OUTPUT PAIRCODE FIRST :MESSAGE "Q]
  9. IF EQUALP (JTOI FIRST :MESSAGE) (JTOI FIRST BF :MESSAGE) ~
  10.    [OUTPUT WORD (PAIRCODE FIRST :MESSAGE "Q) (ENCODE BF :MESSAGE)]
  11. OUTPUT WORD (PAIRCODE FIRST :MESSAGE FIRST BF :MESSAGE) ~
  12.             (ENCODE BF BF :MESSAGE)
  13. END
  14.  
  15. TO ITOJ :LETTER
  16. IF EQUALP :LETTER "I [IF EQUALP RANDOM 3 0 [OUTPUT "J]]
  17. OUTPUT :LETTER
  18. END
  19.  
  20. TO JTOI :WORD
  21. IF EMPTYP :WORD [OUTPUT "]
  22. IF EQUALP FIRST :WORD "J [OUTPUT WORD "I JTOI BF :WORD]
  23. OUTPUT WORD FIRST :WORD JTOI BF :WORD
  24. END
  25.  
  26. TO LETTER :COORDS
  27. OUTPUT ITOJ ITEM LAST :COORDS (ITEM FIRST :COORDS :MATRIX)
  28. END
  29.  
  30. TO LETTERS :ONE :TWO
  31. OUTPUT WORD LETTER :ONE LETTER :TWO
  32. END
  33.  
  34. TO PAIRCODE :ONE :TWO
  35. OUTPUT PAIRCODE1 (THING :ONE) (THING :TWO)
  36. END
  37.  
  38. TO PAIRCODE1 :ONE :TWO
  39. LOCAL [A B C D]
  40. MAKE "A FIRST :ONE
  41. MAKE "B LAST :ONE
  42. MAKE "C FIRST :TWO
  43. MAKE "D LAST :TWO
  44. IF EQUALP :A :C ~
  45.    [OUTPUT LETTERS (LIST :A ROTATE (:B+1)) ~
  46.                    (LIST :A ROTATE (:D+1))]
  47. IF EQUALP :B :D ~
  48.    [OUTPUT LETTERS (LIST ROTATE (:A+1) :B)  ~
  49.                    (LIST ROTATE (:C+1) :B)]
  50. OUTPUT LETTERS (LIST :A :D) (LIST :C :B)
  51. END
  52.  
  53. TO PLAYFAIR :KEYWORD :MESSAGE
  54. SETKEYWORD JTOI :KEYWORD
  55. OUTPUT ENCODE BIGWORD :MESSAGE
  56. END
  57.  
  58. TO REMOVE :LETTERS :STRING
  59. IF EMPTYP :STRING [OUTPUT "]
  60. IF MEMBERP FIRST :STRING :LETTERS [OUTPUT REMOVE :LETTERS BF :STRING]
  61. OUTPUT WORD FIRST :STRING REMOVE :LETTERS BF :STRING
  62. END
  63.  
  64. TO REORDER :STRING
  65. OUTPUT REORDER1 :STRING [] [] 5
  66. END
  67.  
  68. TO REORDER1 :STRING :ALL :ROW :COUNT
  69. IF EQUALP :COUNT 0 [OUTPUT REORDER1 :STRING (LPUT :ROW :ALL) [] 5]
  70. IF EMPTYP :STRING [OUTPUT :ALL]
  71. OUTPUT REORDER1 (BF :STRING) :ALL (LPUT FIRST :STRING :ROW) ~
  72.                 (:COUNT-1)
  73. END
  74.  
  75. TO ROTATE :INDEX
  76. OUTPUT IFELSE EQUALP :INDEX 6 [1] [:INDEX]
  77. END
  78.  
  79. TO SETKEYWORD :WORD
  80. MAKE "MATRIX REORDER WORD :WORD REMOVE :WORD "ABCDEFGHIKLMNOPQRSTUVWXYZ
  81. SETLETTERS :MATRIX
  82. MAKE "J :I
  83. END
  84.  
  85. TO SETLETTERS :MATRIX
  86. SETLETTERS1 :MATRIX 1
  87. END
  88.  
  89. TO SETLETTERS1 :MATRIX :ROW
  90. IF EMPTYP :MATRIX [STOP]
  91. SETLETTERS2 (FIRST :MATRIX) :ROW 1
  92. SETLETTERS1 (BF :MATRIX) (:ROW+1)
  93. END
  94.  
  95. TO SETLETTERS2 :LIST :ROW :COL
  96. IF EMPTYP :LIST [STOP]
  97. MAKE FIRST :LIST LIST :ROW :COL
  98. SETLETTERS2 (BF :LIST) :ROW (:COL+1)
  99. END
  100.  
  101.